home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / DefProcs / SICN Cntl / SICN CDEF.p < prev    next >
Encoding:
Text File  |  1992-07-30  |  11.0 KB  |  206 lines  |  [TEXT/PJMM]
  1.                                 maxValue := GetHandleSize(ourSICN) div (2 * SICNlength) - 1;
  2.                                                 theIncrement := 2;
  3.                                                 if BAND(varCode, doubleIcon) <> 0 then
  4.                                                     begin
  5.                                                         maxValue := maxValue div 2;
  6.                                                         theIncrement := theIncrement * 2;
  7.                                                     end;
  8.                                             end
  9.                                         else
  10.                                             maxValue := 0;
  11.                                         contrlMin := 0;
  12.                                         contrlMax := maxValue;
  13.                                         ourRgn := NewRgn;    {create a region to hold button/title outline}
  14.                                     end;
  15.                                 HUnLock(contrlData);
  16.                             end;
  17.                     end
  18.  
  19.         {----- Disposal -----}
  20.                 else if message = dispCntl then
  21.                     begin
  22. {$IFC Debugging}
  23.                         DebugStr('dispCntl');
  24. {$ENDC}
  25.             {Don't know who else might be using our SICNs, so leave them alone.}
  26.                         if contrlData <> nil then
  27.                             begin
  28.                                 DisposeRgn(DataHandle(contrlData)^^.ourRgn);    {done forever with this region}
  29.                                 DisposHandle(contrlData);    {don't need our local data anymore, either}
  30.                             end;
  31.                     end
  32.  
  33.                 else if contrlData <> nil then
  34.                     begin
  35.                         HLock(contrlData);    {lock down control's private data}
  36.                         with DataHandle(contrlData)^^ do
  37.                             case message of
  38.  
  39.         {----- Drawing -----}
  40.                                 drawCntl: 
  41.                                     begin
  42. {$IFC Debugging}
  43.                                         DebugStr('drawCntl');
  44. {$ENDC}
  45.                                         GetPort(savePort);    {make sure we have the right port}
  46.                                         SetPort(contrlOwner);
  47.                                         with contrlOwner^ do    {remember the original font}
  48.                                             begin
  49.                                                 saveFont := txFont;
  50.                                                 saveSize := txSize;
  51.                                                 saveFace := txFace;
  52.                                             end;
  53.                                         if BAND(varCode, useWFont) = 0 then        {if we need system font, set it}
  54.                                             begin
  55.                                                 TextSize(0);
  56.                                                 TextFont(0);
  57.                                             end;
  58.                                         TextFace([]);    {make sure we have a clean face}
  59.                                         GetFontInfo(info);    {measure the title}
  60. {$PUSH}
  61. {$R-}
  62.                                         titleWidth := TextWidth(@contrlTitle[1], 0, ORD(contrlTitle[0]));
  63. {$POP}
  64.                                         if contrlValue < 0 then    {make sure our control value is legitimate}
  65.                                             contrlValue := 0
  66.                                         else if contrlValue > maxValue then
  67.                                             if maxValue > 0 then
  68.                                                 contrlValue := maxValue
  69.                                             else
  70.                                                 contrlValue := 1;
  71.                                         ourBox := contrlRect;
  72.                                         with ourBox do    {force the rect to fit}
  73.                                             case BAND(varCode, doubleIcon + horizDouble) of
  74.                                                 0: 
  75.                                                     begin
  76.                                                         bottom := top + 16;
  77.                                                         right := left + 16;
  78.                                                         centerLine := left + 8;
  79.                                                         upRect := ourBox;
  80.                                                         SetRect(dnRect, 0, 0, 0, 0);
  81.                                                     end;
  82.                                                 doubleIcon: 
  83.                                                     begin
  84.                                                         bottom := top + 32;
  85.                                                         right := left + 16;
  86.                                                         centerLine := left + 8;
  87.                                                         upRect := ourBox;
  88.                                                         upRect.bottom := top + 16;
  89.                                                         dnRect := ourBox;
  90.                                                         dnRect.top := upRect.bottom;
  91.                                                     end;
  92.                                                 horizDoubleIcon: 
  93.                                                     begin
  94.                                                         bottom := top + 16;
  95.                                                         right := left + 32;
  96.                                                         centerLine := left + 16;
  97.                                                         upRect := ourBox;
  98.                                                         upRect.left := ourBox.left + 16;
  99.                                                         dnRect := ourBox;
  100.                                                         dnRect.right := upRect.left;
  101.                                                     end;
  102.                                             end;
  103.                                         with info, titleRect do
  104.                                             begin    {position the control title and establish its bounding rect}
  105.                                                 top := ourBox.bottom;
  106.                                                 bottom := top + ascent + descent + leading;
  107.                                                 left := centerLine - titleWidth div 2;
  108.                                                 right := left + titleWidth;
  109.                                                 textBaseline := bottom - descent;
  110.                                             end;
  111.                                         InsetRect(titleRect, -titleInset, 0);
  112.                                         OpenRgn;    {make our region include the icon and the label}
  113.                                         FrameRect(ourBox);
  114.                                         if BAND(varCode, showTitle) <> 0 then
  115.                                             FrameRect(titleRect);
  116.                                         CloseRgn(ourRgn);    {save the control's region for future reference}
  117.                                         if contrlVis <> 0 then {if the control is visible…}
  118.                                             if ourSICN <> nil then    {…and the SICN is present…}
  119.                                                 begin    {draw the control}
  120.                                                     LoadResource(ourSICN);
  121.                                                     if BAND(varCode, showTitle) <> 0 then
  122.                                                         begin    {draw the title}
  123.                                                             EraseRect(titleRect);
  124.                                                             MoveTo(titleRect.left + titleInset, textBaseline);
  125.                                                             DrawString(contrlTitle);
  126.                                                         end;
  127.                                                     if maxValue > 0 then
  128.                                                         drawValue := contrlValue
  129.                                                     else
  130.                                                         drawValue := 0;
  131.                                                     case contrlHilite of
  132.                                                         0, 255:    {display normal control}
  133.                                                             begin
  134.                                                                 PlotSICN(ourSICN, drawValue * theIncrement, upRect);
  135.                                                                 PlotSICN(ourSICN, drawValue * theIncrement + 2, dnRect);
  136.                                                             end;
  137.                                                         1:    {display active control — ‘up’ pressed}
  138.                                                             begin
  139.                                                                 PlotSICN(ourSICN, drawValue * theIncrement + 1, upRect);
  140.                                                                 if maxValue = 0 then
  141.                                                                     contrlValue := 1
  142.                                                                 else if (theIncrement = 2) & (maxValue = contrlValue) then
  143.                                                                     contrlValue := 0
  144.                                                                 else
  145.                                                                     contrlValue := contrlValue + 1;
  146.                                                             end;
  147.                                                         2:     {display active control — ‘dn’ pressed}
  148.                                                             begin
  149.                                                                 PlotSICN(ourSICN, drawValue * theIncrement + 3, dnRect);
  150.                                                                 contrlValue := contrlValue - 1;
  151.                                                             end;
  152.                                                     end;
  153.                                                     if contrlHilite = 255 then
  154.                                                         begin    {grey out disabled control}
  155.                                                             PenPat(patGrey);
  156.                                                             PenMode(patBic);
  157.                                                             PaintRect(ourBox);
  158.                                                             PaintRect(titleRect);
  159.                                                         end;
  160.                                                 end
  161.                                             else
  162.                                                 begin    {no icon? draw a blank…}
  163.                                                     PenPat(patGrey);
  164.                                                     PaintRect(ourBox);
  165.                                                 end;
  166.                                         TextFont(saveFont);    {set everything back the way it was}
  167.                                         TextSize(saveSize);
  168.                                         TextFace(saveFace);
  169.                                         SetPort(savePort);
  170.                                     end;
  171.  
  172.         {----- Testing -----}
  173.                                 testCntl: 
  174.                                     begin
  175. {$IFC Debugging}
  176.                                         DebugStr('testCntl');
  177. {$ENDC}
  178.                                         if (contrlHilite <> 255) then
  179.                                             if PtInRect(Point(param), upRect) then
  180.                                                 main := upPartCode
  181.                                             else if PtInRect(Point(param), dnRect) then
  182.                                                 main := dnPartCode;
  183.                                     end;
  184.  
  185.         {----- Regions -----}
  186.                                 calcCRgns, calcCntlRgn: 
  187.                                     begin
  188. {$IFC Debugging}
  189.                                         DebugStr('calcCRgns, calcCntlRgn');
  190. {$ENDC}
  191.                                         if (message <> calcCRgns) or not BTST(param, 31) then
  192.                                             CopyRgn(ourRgn, RgnHandle(param));    {return control region}
  193.                                     end;
  194.  
  195.                                 otherwise
  196.                                     ;    {don't handle other messages}
  197.  
  198.                             end;
  199.                         HUnLock(contrlData);
  200.                     end;
  201.             end;
  202.         HUnLock(Handle(theControl));
  203.     end;
  204.  
  205.  
  206. end.